00100	C  WORDS, TYPE, SETLET, SETNUM ,(NEWR,LNEND), FILLMS, PRESCN
00200		
00300		SUBROUTINE WORDS
00330		INTEGER PWDS
00400		COMMON R2,JA,RC,J3,R3,R4,R5,R6,R7,X,IA,N
00500		1,Z,J,KN,ISET,Q(27),JR /PTR/PWDS(250),ITEM,LL,IS,IX
00550	C  /SCX/ IS ALSO IN SCMSS, NOTBMS, RHYTH, BEAMS, NEWR(IN LOOP.FAI)
00560	C **** WHEN JALPHA IS EXTENDED FIX LOOP AT 365 AND SUBR. NEWR(IN LOOP)
00570	C **** AND SUBR. SCMSS, NOTBMS, RHYTH AND BEAMS
00600		COMMON/SCX/RHY(4),JALPHA(30),J4,L,Y,K,RX,RZ,RA,J5
00700		1/XRN/RN(4000) /ALF/INP(72),ML
00702		COMMON/SCN/LEL,LR,LU,LD,KSLA,LE,LC,LS,LF,LA,LI,LW
00710		EQUIVALENCE (IBLA,JALPHA(12))
00900		DATA JALPHA/',','-','.','=','(',')','+','*',':',';'
01000		1 ,'"',' ','$','%','&','@','#','<','>',1H','?','!'
01050		1 ,"555004020100,"565004020100,"571004020100,"5004020100,
01060		1 "135004020100,0,0,0/
01100	C   FOR ENTERING TEXT: 16, POS., STF., NT#., SIZE,  RHYTHM≠0
01200	C  R6 ≠0 CALLS NOTE NUM. SETUP
01210		JR=-1
01220		IF(R3.NE.999)GO TO 131
01230		TYPE 331
01240		ACCEPT 631,KN
01250		IF(LOOK(KN).EQ.0)RETURN
01260	C  GO BACK IF NO FILE FOUND
01270		CALL IFILE(21,KN)
01280		READ(21,431)JR,INP
01290		JR=0 
01295		R6=1
01300		GO TO 531
01305	631	FORMAT(A5)
01310	331	FORMAT(' TYPE FILE NAME-- '$)
01320	431	FORMAT(I,72A1)
01390	131	CALL TYPE
01400	531	DO 31 KN=72,1,-1
01500	31	IF(INP(KN).NE.IBLA)GO TO 33
01600	C  KN=NUM OF CHARACTERS
01700	C  DON'T END WITH '*' IN 'LETTERS' INPUT!!!!!!!!
01800	C  , - . = ( ) + * : ; " BLANK (FONTS) ' --THIS IS ORDER PAST ALPHAB.
01810	C [=QTR NOTE, ]=HALF NOTE, ↑=#, ↓=b, ↔=NATURAL, 3 SLOTS STILL OPEN
01820	
01900	C  48 $=UPPER CASE, 49 %=LOWER, 50 &=NON-ITALICS, 51 @=ITALICS
01950	C  48 AND 49 NOT NEEDED NOW  6/75
02000	C  52 #=RETURN TO PRIMITVE FONT, 53 <=OPEN, 54 >=FILLED. ('=55)
02100	33	L=1
02105		RC=0
02110		IF(INP(KN).EQ.KSLA)GO TO 133
02120		KN=KN+1
02130		INP(KN)=KSLA
02140	C  SO TRAILING BLANKS ARE DELETED.
02200	133	LL=1
02205		RZ=0 
02210		ISET=IS
02220		IF(R3.LT.1000)GO TO 233
02225		RZ=1
02230		R3=R3-1000.
02240		RC=R3
02250	C  ADD 1000 TO POSITION (R3+1000) FOR CENTERING AT POS. R3.
02300	233	RA=R3
02400	C   RA= ADDS UP TOTAL SPACE NEEDED
02500		RX=0
02800	C  FOR SETLET
02900	368	RN(IS+1)=16
03000		RN(IS+3)=RA
03100	C  NEXT IS A MAGIC NUMBER FOR SPACING LETTERS.
03200	CC	Y=39.6*RSTJ3
03300	C  RBL IS FOR CONTROL(NON-LETTERS, ETC.) CHARACTERS.
03400		RN(IS+2)=R2
03500		RN(IS+4)=R4
03600		CALL NOZERO(R5)
03700		RN(IS+5)=R5
03750		IF(R5.GE.100)R5=R5-100
03775	C >100 FOR TEXT IN ORCH SCORES TO GO IN ALL SEP. PARTS.
03800	
03900		DO 364 J5=6,8
04000		Z=0
04100		DO 363 J4=1,4
04200	361	IA=INP(L)
04300		IF(IA.NE.KSLA)GO TO 365
04400	C  NEG. SPACE IS ENTERED IN P1 FOR EACH "FIRST" ITEM.
04500		J3=J4
04600		DO 367 KA=J5,8
04700		X=99.
04800		DO 366 K=J3,4
04900		Z=Z+X
05000	366	X=X*100.0
05100		RN(IS+KA)=Z
05200		J3=1
05300	367	Z=0
05400		L=L+1
05500	C  L=CHARACTER COUNTER
05600		GO TO 369
05700	365	DO 362 J=1,30
05800		IF(IA.NE.JALPHA(J))GO TO 362
05900		N=35+J
06000	C  FOUND A SPECIAL CHARACTER.
06010		K=N
06055		IFNT=0
06100		GO TO 39
06200	362	CONTINUE
06300	38	N=10-(LA-INP(L))/536870912
06400	C   MAGIC NUMBER TO FIND LETTERS
06500		IF(N.LT.10)N=N+7
06510		K=N
06520		IF(KFNT)IFNT=0
06550		IF(N.LT.40)GO TO 39
06560		N=N+28
06565		KFNT=-1
06567	C  TO INITIALIZE AUTOMATIC LOWER CASE SYSTEM.
06570		K=N-60
06571	C  K IS ACTUAL LETTER NUMB. (a=10, ETC.)
06572		IFNT=-1
06575	C LOWER CASE LETTERS ARE 60 .GT. UPPER. A=10, a=70, b=71, etc.
06600	39	L=L+1
06700	C  BLANK=99(=47)
06800		CALL SPACER(K,IFNT,RX,3.32)
06900	C  NUM↑↑=19.7/5.96  FOR BASIC SPACE PER LETTER.
07000	C  GET SPACE FOR THIS LETTER.
07100		X=N
07200		IF(J4.EQ.2)X=X*10000.
07300		IF(J4.EQ.3)X=X*100.
07400		IF(J4.EQ.1)X=X*1000000.
07500	363	Z=Z+X
07600	364	RN(IS+J5)=Z
07700	369	RN(IS+9)=RX
07800		RN(IS+10)=RZ
07850		IF(RC.NE.0)RN(IS+10)=RC
07875		RC=0
07900	C  FOR CONTINUATION
08000		RA=RA+RX*R5
08050		IF(IA.EQ.KSLA)RA=RA+5
08075	C  SPACES GROUPS DIVIDED BY SLASHES
08100		RX=0
08200		RN(IS)=7+RZ
08300		IS=IS+10+RZ
08400		LL=LL+1
08500		PWDS(ITEM+LL)=IS
08600	C  PUT IT IN THE PNTR ARRAY
08700		RZ=1.
08800		IF(IA.EQ.KSLA)RZ=0
08900		IF(L.LE.KN)GO TO 368
09000	
09100		INP(1)=0
09200	C   SO IT WON'T FIND A COMMAND IN THE MAIN PROG.
09300		IF(R6.NE.0)CALL SETLET
09325		IF(KFNT)IFNT=0
09350		KFNT=0
09400		END
09500	C  PACKS 4 CHARS/WD, 3 WDS/ITEM.
09600	
09700		SUBROUTINE TYPE
09710		COMMON R2,JA,CENTR,J2,R3,R4,R5,RJQ(17),JQ(14),M,K,J,X,A,B
09800		COMMON/ALF/INP(72),ML
09900		TYPE 8005
10000		ACCEPT 2114,INP
10100	2114	FORMAT(72A1)
10200	8005	FORMAT(' TYPE --'/)
10250	CC**    	IF(JA.NE.16)CALL LNEND
10275	C  FOR 'SCORE' INPUT
10300		END
10400	
10600		SUBROUTINE SETLET
10800		COMMON/SCM/V(78),Y,LCNT,STAFF,JLIST(200),REND
10900		COMMON R2,JA,CENTR,J2,R3,R4,R5,RJQ(17),JQ(14),M,K,J,X,A,B
11000		1 /FLM/RPOS(2,300) /PTR/PWDS(250),ITEM,L,I,IX /XRN/RN(4000)
11100		COMMON/FRMT/F78F(1),FA1(1),FA5(1),KK
11110		DIMENSION SU(320)
11146		COMMON/POSI/STF(-3/4),J102,POS/DPY/ST(4000),WDS(250),MEDIT,IGO
11200		EQUIVALENCE (J5,JQ(3)),(ISET,RJQ(9)),(SU(1),ST(3600))
11250		DATA DISP/0.0/
11260		KK=L
11280	C  L=NUMBER OF ITEMS TYPED +1
11300		M=1
11350		R4=20
11400		RPOS(1,1)=0
11500		DO 1 K=1,ITEM
11600		IF(FINDIT(K))GO TO 1
11700	C SKIPS NON-NOTES AND WRONG STAFF
11800		M=M+1
11900		RPOS(1,M)=RN(L+3)
12100	1	CONTINUE
12150		IF(M.EQ.1)RETURN
12175	C  M=1 MEANS NO NOTES ON THIS LINE
12200	CXX	CALL SETNUM
12210		CALL DPYSET(3,SU,320)
12222		CALL DPYBRT(6)
12234	CC	R6=1
12246		POS=STF(IFIX(R2))
12282		J5=1
12300		CALL SORT2(RPOS,M)
12400		K=2
12500	22	IF(IFIX(RPOS(1,K)*100.).NE.IFIX(RPOS(1,K-1)*100.))GO TO 2
12550	C  ROUNDS OFF POSITION TO 2 DECI. PLACES
12600		M=M-1
12700		DO 20 J=K,M
12800	20	RPOS(1,J)=RPOS(1,J+1)
12900	C  DELETES DOUBLE-STOPS - DOESN'T PUT NUM OVER 1ST NOTE.
12950		IF(K.LT.M)K=M
13000		GO TO 22
13100	2	K=K+1
13200		IF(K.LT.M)GO TO 22
13300		DO 4 K=2,M
13400		R3=RHORZ(RPOS(1,K))
13500		CALL PNUM
13600		J5=J5+1
13700	4	IF(J5.EQ.10)J5=0
13800		CALL DPYOUT(3)
13900		CALL SETPOG(1)
14000		RPOS(1,M+1)=200
14100		J=1
14120		IF(B)GO TO 30
14130	C  B IS JR IN 'WORDS'    NEXT FOR READIN FILES WITH WORDS
14140		READ(21,F78F)X,(V(K),K=1,77)
14150		GO TO 31
14200	30	CALL TYPE
14300		REREAD F78F,V
14400	31	X=V(J)+1
14410		DO 32 K=77,1,-1
14420	32	IF(V(K).NE.0)GO TO 320
14430	320	IF(K.GT.KK)KK=-1
14440	C  NOW PAIRS OF NUMS WILL SET INDIV. VERT. POS.; SINGLE DON'T
14600	3	K=X
14610	CC	MM=ISET+4
14700		A=RPOS(1,K)
14800		B=RPOS(1,K+1)
14900		RN(ISET+3)=A+(B-A)*(X-K)+DISP
14950	C  DISP IS DISPLACEMENT OF CURRENT LETTERS.
15000	CC	IF(RN(MM).NE.0)GO TO 5
15010		IF(KK.GT.0)GO TO 5
15020	C  NEXT FOR PAIRS OF NUMS.
15100	CC	RN(MM)=V(J+1)
15110		RN(ISET+4)=V(J+1)
15200		J=J+2
15300		GO TO 6
15400	C IF P4≠0 TYPE ONLY 1 # FOR EACH ITEM. ALL ITEMS WILL BE AT VRT PS OF P4
15500	C TYPE Nn, Vert pos/Nn, Vert pos/  OR  Nn/Nn/ (if P4≠0)
15600	5	J=J+1
15700	6	ISET=ISET+RN(ISET)+3
15710		IF(RN(ISET).EQ.8)GO TO 6
15720	C  =8 MEANS MORE LETTERS TO COME.
15800		X=V(J)+1
15900		IF(X.GT.1)GO TO 3
16000	C CAN'T PUT LETTER AT POS. 0 *********
16100		END
16200	
21700	CF	SUBROUTINE NEWR
21800	CF	COMMON/PTR/PWDS(250),ITEM,LL,IS,IX
21900	CF	COMMON/XRN/RN(4000)
22000	CF	COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
22100	CF	COMMON/SCX/RHY(4),JALPHA(22),JX,U,JZ,IRHY,J4,KA,KB,IZ
22200	CF	1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
22300	CF	1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
22400	CF	DIMENSION R(10,80)
22500	CF	EQUIVALENCE (R,RN(3001))
22600	
22700	CF	IF(MODE.NE.1)GO TO 1
22800	CF	IK=IS
22900	CF	JIT=ITEM
23000	CF1	IS=IK
23100	CF	ITEM=JIT+1
23200	C  MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
23300	CF	DO 2 K=1,IZ
23400	CF	IF(R(8,K).EQ.9999.)GO TO 2
23500	C  SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
23600	C  JUMP FOR BEAM CONT.
23700	CF	IEND=-1
23750	CF	RN(IS+3)=0
23760	CF	RN(IS+2)=0
23800	C  ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
23900	CF	DO 3 L=9,1,-1
24000	CF	A=R(L,K)
24100	CF	IF(A.NE.0)GO TO 77
24150	CF	IF(IEND)GO TO 3
24200	CF77	IF(IEND)IEND=L
24300	CF	RN(IS+L)=A
24400	CF3	CONTINUE
24500	CF	IF(IEND.LT.3)IEND=3
24700	CF	CALL UPDATE(IEND-2)
24800	CF2	CONTINUE
24900	CF	END
25000	
25300		SUBROUTINE LNEND
25400	C  CHANGES LINE ENDS SO INPUT CAN LOOK LIKE NEW 'SCORE' INPUT.
25500		COMMON /ALF/INP(1),ML 
25510		COMMON/SCX/RHY(4),JALPHA(30),J4,L,Y,K,RX,RZ,RA,J5
25555		EQUIVALENCE (ISEMI,JALPHA(10)),(ISTAR,JALPHA(8))
25600		DO 2902 L=72,1,-1
25700		IF(INP(L).NE.'/')GO TO 2903
25800		INP(L)=ISEMI
25900		RETURN
26000	2903	IF(INP(L).NE.ISEMI)GO TO 2902
26100		INP(L)=ISTAR
26200		RETURN
26300	2902	CONTINUE
26400		END
26500	
26600	
27000	C**** CHANGE 1, 2 AND 3 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
27100		SUBROUTINE FILLMS(L,IDAT,R2,CENTR,R6,R7)
27200		COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO/DL/RSIZ,SAVER,NAME
27300		COMMON/DST/BB,CC/FLM/X(600)
27400		COMMON/ALF/INP(65),DX,RX,D,R,C,KK,J,ML
27500		DIMENSION IDAT(1),NX(600)
27600		EQUIVALENCE (NX,X)
27700		COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJ2
28000		DATA MD/6/ , RHT/1.0/
28100	C MD=DISPLAY   CHANGE XGP TO 1 IN DDT WHEN PLOTTING ON XGP!
28200		DX=DIS
28300		RX=RHT
28400		D=RSTJ2*R6
28500		R=RSTJ2*R7
28600	1	GO TO 10
28700		C=CC
28800		B=BB
28900	C  SAVES IT.  IT WILL RETURN LATER.
29000		BB=B/DIS
29100		CC=1000
29200	10	KK=-2
29300		DO 205 J=1,L
29400		CALL UNPACK(M,N,IDAT(J))
29500		KK=KK+3
29600		KX=KK+2
29700		NX(KX)=2
29800		IF(LL.EQ.3)NX(KX)=3
29900		X(KK)=ROFF((R2+D*M)*DIS)
30000		X(KK+1)=ROFF((CENTR+R*N)*RHT)
30100	2	GO TO 205
30200		X(KK+1)=X(KK+1)*(C-BB*(ABS(X(KK))))
30300	C  FOR DISTORTION
30400	205	CONTINUE
30500		NX(3)=KX
30600		DIS=1.0
30700		RHT=DIS
30800		M=MD
30900	CC	IF(IPLT)M=MP-IXRX
31000		IF(IPLT.GE.0)GO TO 20
31100	CC	M=RSIZ+.4
31200		M=1
31300		IF(RSIZ.GE.2.)M=2
31400	CC	IF(M.GT.XGP)M=XGP
31500	C  STOPS DISTORTION IN 'LINES'
31600	20	CALL FILLER(X,M)
31700	C  ******  CALLS NEW FILL.FAI (CLEM'S)
31800		DIS=DX
31900		RHT=RX
32000	3	RETURN
32100	C  NEXT TO RESET DISTORTION FACT.
32200		BB=B
32300		CC=C
32400		END
32500	
32600	
32700		SUBROUTINE PRESCN
32800	C  THIS SORTS OUT NEW INPUT FORMAT - CREATES OLD STYLE.
32900		COMMON/SCX/RHY(4),JALPHA(30),J4,L,Y,K,RX,RZ,RA,J5
33000		COMMON/SCN/LL,LR,LU,LD,LSL,LE,LC,LS,LF,LA,LI,LW
33100		DATA LL/'L'/,LR/'R'/,LU/'U'/,LD/'D'/,LE/'E'/,LSL/'/'/
33200		1,LC/'C'/,LS/'S'/,LF/'F'/,LA/'A'/,LI/'I'/,LW/'W'/
33300		DIMENSION IR(1)
33400		COMMON/ALF/INP(72),M/XRN/RN(4000)
33500		EQUIVALENCE (IR,RN(2001)),(LCM,JALPHA),(LBL,JALPHA(12))
33600		1,(LST,JALPHA(8)),(ISEMI,JALPHA(10)),(ICOL,JALPHA(9))
33650		1,(IDOT,JALPHA(3))
33700	C  CHECK THIS EQUIV.↑↑↑↑
33800	100	IF(ISM)5,55,555
33900	C  -1=PROCESS SOME MORE, 0=1ST TIME, 1=PUT OUT RHYTH
34000	C  !!!!! DON'T STOP IN THE MIDDLE!!!  ISM MUST BE 0 FIRST TIME!!!!
34100	55	JX=0
34200	5	K=0
34300		J=0
34400		I=JX
34500		JX=JX+72
34600	1	K=K+1
34700		M=INP(K)
34800	15	IF(M.EQ.LBL)GO TO 1
34900		IF(M.EQ.LCM)GO TO 1
35000	C  REMOVE BLANKS AND COMMAS
35100		JN=0
35200		IF(M.LT.'0')GO TO 677
35300		IF(M.LE.'9')GO TO 2
35400	677	MM=INP(K+1)
35500	3	IF(M.EQ.'P')GO TO 8
35600		IF(M.EQ.'O')GO TO 8
35700		IF(M.LT.LA)GO TO 777
35800		IF(M.GT.'G')GO TO 777
35900		IF(MM.EQ.LL)GO TO 777
36000		IF(MM.NE.LA)GO TO 8
36100	C  FINDS NOTES, PROX., AND ORDINARY, -- NOT 'BA' OR 'AL'
36200	777	IF(M.NE.LR)GO TO 9
36300		IF(MM.EQ.LE)JN=1
36400	C  CATCHES 'R' 'RI' 'REP'
36500		GO TO 8
36600	9	IF(M.EQ.LSL)GO TO 8
36700		IF(M.EQ.ISEMI)GO TO 8
36800		IF(M.EQ.LST)GO TO 8
36900		IF(M.EQ.ICOL)GO TO 8
37000		JN=-1
37100	8	J=J+1
37200		 INP(J)=M
37300		IF(M.EQ.'X')JN=1
37400	C  PICKS UP 4X ETC. FOR BOTH NOTES AND RHYTH.
37500		IF(JN.LE.0)GO TO 13
37600	C  PUTS 'REP' INTO RHYTH ALSO
37700		I=I+1
37800		IR(I)=M
37900	13	IF(M.EQ.LSL)GO TO 4
38000		IF(M.EQ.ISEMI)GO TO 4
38100		IF(M.EQ.LST)GO TO 4
38200		K=K+1
38300		M=INP(K)
38400		GO TO 8
38500	
38600	4	IF(JN.NE.0)GO TO 7
38700		I=I+1
38800		IR(I)=M
38900	7	IF(M.EQ.LSL)GO TO 1
39000		IF(M.EQ.ISEMI)GO TO 11
39100		IF(M.EQ.LST)GO TO 6
39200	
39300	2	I=I+1
39400		IR(I)=M
39500		K=K+1
39600		M=INP(K)
39700		IF(M.EQ.IDOT)GO TO 2
39800		IF(M.LT.'0')GO TO 15
39900		IF(M.LE.'9')GO TO 2
40000	C  NO BLANK NEEDED AFTER RHYTH.( /4.AS3/8/ ETC.)
40100		GO TO 15
40200	
40300	11	IF(IR(I).NE.ISEMI)IR(I)=ISEMI
40400		ISM=-1
40500		RETURN
40600	C  WE'LL COME BACK FOR MORE.
40700	
40800	6	IF(IR(I).NE.LST)IR(I)=LST
40900		JX=0
41000		ISM=1
41100	C AFTER THIS WE USE RHYTJ DATA.
41200		RETURN
41300	
41400	555	DO 12 K=1,72
41500		M=IR(K+JX)
41600		INP(K)=M
41700		IF(M.EQ.ISEMI)GO TO 10
41800	C  MORE THAN ONE LINE
41900	12	IF(M.EQ.LST)GO TO 14
42000	10	JX=JX+72
42100	C  MOVE TO THE NEXT 'LINE'
42200		RETURN
42300	14	ISM=0
42400		END